#include <stdio.h>
#include <stdlib.h>
#include <memory.h>
#ifdef __STDC__
#include <stdarg.h>
#else
#include <varargs.h>
#endif

#include <errno.h>

int exppp_output_filename_reset;	/* if true, force output filename */
  /* DAR - moved this from .h file - not sure why was there. */

#include "expbasic.h"
#include "express.h"
#include "exppp.h"

#define EXPR_out(e,p) EXPR__out(e,p,OP_UNKNOWN)
#define EXPRop2_out(oe,string,paren,pad) \
        EXPRop2__out(oe,string,paren,pad,OP_UNKNOWN)
#define EXPRop_out(oe,paren) EXPRop__out(oe,paren,OP_UNKNOWN)

void ALGscope_out(Scope s, int level);
void ENTITYattrs_out(Linked_List attributes,int derived,int level);
void ENTITY_out(Entity e,int level);
void ENTITYinverse_out(Linked_List attrs,int level);
void ENTITYunique_out(Linked_List u,int level);
void EXPRop__out(struct Op_Subexpression *oe,int paren,int previous_op);
void EXPRop_string(char *buffer,struct Op_Subexpression *oe);
void EXPRop1_out(struct Op_Subexpression *eo,char *opcode,int paren);
void EXPRop2__out(struct Op_Subexpression *eo,char *opcode,int paren,int pad,int previous_op);
void EXPR__out(Expression expr,int paren,int previous_op);
void EXPRbounds_out(TypeBody tb);
void FUNC_out(Function fn,int level);
void PROC_out(Procedure p,int level);
void REFout(Dictionary refdict,Linked_List reflist,char *type,int level);
void RULE_out(Rule r,int level);
void SCOPEalgs_out(Scope s,int level);
void SCOPEconsts_out(Scope s,int level);
void SCOPEentities_out(Scope s,int level);
void SCOPElocals_out(Scope s,int level);
void SCOPEtypes_out(Scope s, int level);
void STMT_out(Statement s,int level);
void TYPE_out(Type t, int level);
void TYPE_head_out(Type t,int level);
void TYPE_body_out(Type t, int level);
void WHERE_out(Linked_List wheres,int level);

static Error ERROR_select_empty;

int exppp_nesting_indent = 2;		/* default nesting indent */
int exppp_continuation_indent = 4;	/* default nesting indent for */
					/* continuation lines */
int exppp_linelength = 75;		/* leave some slop for closing
					/* parens.  \n is not included in */
					/* this count either */

int indent2;		/* where continuation lines start */
int curpos;		/* current line position (1 is first position) */

#define NOLEVEL -1	/* unused-level indicator */

char *exppp_output_filename = (char *)0;	/* if this is set, override */
			/* default output filename */
char filename[1000];	/* output file name */
Symbol error_sym;	/* only used when printing errors */

char *expheader[] = {
"(* This file was generated by exppp (an EXPRESS Pretty Printer)"	,
"written at the National Institute of Standards and Technology"		,
"by Don Libes, February 19, 1993."					,
""									,
"WARNING: If you modify this file and want to save the changes,"	,
"delete this comment block or else the file will be rewritten"		,
"the next time exppp processes this schema. *)"				,
0};

int exppp_alphabetize = False;

int exppp_terse = False;

int exppp_reference_info = False;	/* if true, add commentary */
					/* about where things came from */

int exppp_preserve_comments = False;

int exppp_rmpp = True;
char rmfilename[] = "rmpp";
FILE *rm;

char *rmheader[] = {
"# This file was generated by exppp (an EXPRESS Pretty Printer)"	,
"# written at the National Institute of Standards and Technology"	,
"# by Don Libes, February 19, 1993."					,
""									,
"# Run this script from the shell to remove any files created by"	,
"# the last run of exppp."						,
""									,
0};

FILE *exppp_fp = NULL;		/* output file */
char *exppp_buf = 0;		/* output buffer */
int exppp_maxbuflen = 0;		/* size of expppbuf */
int exppp_buflen = 0;		/* remaining space in expppbuf */
char *exppp_bufp = 0;		/* pointer to write position in expppbuf */
				/* should usually be pointing to a "\0" */

/* count newlines in a string */
int
count_newlines(s)
char *s;
{
	int count = 0;
	for (;*s;s++) {
		if (*s == '\n') count++;
	}
	return count;
}

void
exp_output(char *buf, int len)
{
	FILE *fp = (exppp_fp?exppp_fp:stdout);

	error_sym.line += count_newlines(buf);

	if (exppp_buf) {
		/* output to string */
		if (len > exppp_buflen) {
			/* should provide flag to enable complaint */
			/* for now, just ignore */
			return;
		}
		memcpy(exppp_bufp,buf,len+1);
		exppp_bufp += len;
		exppp_buflen -= len;
	} else {
		/* output to file */
		fwrite(buf,1,len,fp);
	}
}

void
#ifdef __STDC__
wrap(char *fmt, ...)
{
#else
wrap(va_alist)
va_dcl
{
	char *fmt;
#endif
	FILE *f = exppp_fp?exppp_fp:stdout;
	char *p;
	char buf[10000];
	int len;
	va_list args;
#ifdef __STDC__
	va_start(args,fmt);
#else
	va_start(args);
	fmt = va_arg(args,char *);
#endif

	vsprintf(buf,fmt,args);
	len = strlen(buf);

	/* 1st condition checks if string cant fit into current line */
	/* 2nd condition checks if string cant fit into any line */
	/* I.e., if we still can't fit after indenting, don't bother to */
	/* go to newline, just print a long line */
	if (( (curpos + len) > exppp_linelength) &&
	    ((indent2 + len) < exppp_linelength)) {
		/* move to new continuation line */
		char line[1000];
		sprintf(line,"\n%*s",indent2,"");
		exp_output(line,1+indent2);

		curpos = indent2;		/* reset current position */
	}

	exp_output(buf,len);

	if (len) {
		/* reset cur position based on last newline seen */
		if (0 == (p = strrchr(buf,'\n'))) {
			curpos += len;
		} else {
			curpos = len + buf - p;
		}
	}
}

void
#ifdef __STDC__
raw(char *fmt, ...)
{
#else
raw(va_alist)
va_dcl
{
	char *fmt;
#endif
	FILE *f = exppp_fp?exppp_fp:stdout;
	char *p;
	char buf[10000];
	int len;
	va_list args;
#ifdef __STDC__
	va_start(args,fmt);
#else
	va_start(args);
	fmt = va_arg(args,char *);
#endif

	vsprintf(buf,fmt,args);
	len = strlen(buf);

	exp_output(buf,len);

	if (len) {
		/* reset cur position based on last newline seen */
		if (0 == (p = strrchr(buf,'\n'))) {
			curpos += len;
		} else {
			curpos = len + buf - p;
		}
	}
}

void
exppp_init()
{
	static int first_time = True;

	if (!first_time) return;
	first_time = False;

	ERROR_select_empty = ERRORcreate(
"select type %s has no members",SEVERITY_ERROR);
}

void
EXPRESSout(Express e)
{
	Schema s;
	DictionaryEntry de;
	char **hp;

	exppp_init();

	if (exppp_rmpp) {
		if (!(rm = fopen(rmfilename,"w"))) {
			ERRORreport(ERROR_file_unwriteable,rmfilename,strerror(errno));
			return;
		}

		for (hp=rmheader;*hp;hp++) {
			fprintf(rm,"%s\n",*hp);
		}
		fprintf(rm,"rm -f");
	}

	DICTdo_init(e->symbol_table,&de);
	while (0 != (s = (Schema)DICTdo(&de))) {
		(void) SCHEMAout(s);
	}

	if (exppp_rmpp) {
		fprintf(rm," %s\n",rmfilename);

		/* owner+group executable, readable to world */
		if (0 != chmod(rmfilename,0774)) {
			fprintf(stderr,"%s: could not mark %s executable (%s)\n",
				EXPRESSprogram_name,rmfilename,strerror(errno));
			return;
		}
	}
}

void
exppp_ref_info(Symbol *s)
{
	if (exppp_reference_info) {
		raw("--info %s %s %d\n",s->name,s->filename,s->line);
	}
}

/* normally all non-schema objects start out by printing a newline */
/* however, this is undesirable when printing out single objects */
/* use this variable to avoid it */
static int first_line = True;		/* if first line */

static void
first_newline()
{
	if (first_line) first_line = False;
	else raw("\n");
}

char *		/* returns name of file written to in static storage */
SCHEMAout(Schema s)
{
#define BUFSIZE		80
	char buf[BUFSIZE];	
	char *p;
	FILE *f;
	int level = 0;
	char **hp;
	int described = False;

	if (exppp_output_filename_reset) {
		exppp_output_filename = 0;
	}

	if (exppp_output_filename) strcpy(filename,exppp_output_filename);
	else {
		/* when there is only a single file, allow user to find */
		/* out what it is */
		exppp_output_filename = filename;
		exppp_output_filename_reset = True;

		/* since we have to generate a filename, make sure we don't */
		/* overwrite a valuable file */

		sprintf(filename,"%s.exp",s->symbol.name);

		if (0 != (f = fopen(filename,"r"))) {
			fgets(buf,BUFSIZE,f);
			if (0 != (p = strchr(buf,'\n'))) *p = '\0';
			if (streq(buf,expheader[0])) {
				unlink(filename);
			} else {
				fprintf(stderr,"%s: %s already exists and appears to be hand-written\n",
					EXPRESSprogram_name,filename);
	/*			strcat(bp,".pp");*/
				strcat(filename,".pp");
				fprintf(stderr,"%s: writing schema file %s instead\n",
					EXPRESSprogram_name,filename);
				described = True;
			}
		}
		fclose(f);
	}
	error_sym.filename = filename;

	if (!described && !exppp_terse) {
		fprintf(stdout,"%s: writing schema file %s\n",EXPRESSprogram_name,filename);
	}
	if (!(exppp_fp = f = fopen(filename,"w"))) {
		ERRORreport(ERROR_file_unwriteable,filename,strerror(errno));
		return 0;
	}

	if (exppp_rmpp && rm) fprintf(rm," %s",filename);

	error_sym.line = 1;
	for (hp=expheader;*hp;hp++) {
		raw("%s\n",*hp);
	}

/*	first_newline();*/
/*	raw("SCHEMA %s;\n",s->symbol.name);*/

	first_line = False;
	raw("\nSCHEMA %s;\n",s->symbol.name);

	if (  s->u.schema->usedict || s->u.schema->use_schemas
	   || s->u.schema->refdict || s->u.schema->ref_schemas) raw("\n");

	REFout(s->u.schema->usedict,s->u.schema->use_schemas,"USE",level+exppp_nesting_indent);
	REFout(s->u.schema->refdict,s->u.schema->ref_schemas,"REFERENCE",level+exppp_nesting_indent);

	SCOPEconsts_out(s,level+exppp_nesting_indent);
	SCOPEtypes_out(s,level+exppp_nesting_indent);
	SCOPEentities_out(s,level+exppp_nesting_indent);
	SCOPEalgs_out(s,level+exppp_nesting_indent);

	raw("\nEND_SCHEMA; -- %s\n",s->symbol.name);

	fclose(exppp_fp);

	return filename;
}

void
REFout(Dictionary refdict,Linked_List reflist,char *type,int level)
{
	Dictionary dict;
	DictionaryEntry de;
	struct Rename *r;
	Linked_List list;

	LISTdo(reflist,s,Schema)
		raw("%s FROM %s;\n",type,s->symbol.name);
	LISTod

	if (!refdict) return;
	dict = DICTcreate(10);

	/* sort each list by schema */

	/* step 1: for each entry, store it in a schema-specific list */
	DICTdo_init(refdict,&de);
	while (0 != (r = (struct Rename *)DICTdo(&de))) {
		Linked_List list;

		list = (Linked_List)DICTlookup(dict,r->schema->symbol.name);
		if (!list) {
			list = LISTcreate();
			DICTdefine(dict,r->schema->symbol.name,list,
				(Symbol *)0,OBJ_UNKNOWN);
		}
		LISTadd(list,r);
	}

	/* step 2: for each list, print out the renames */
	level = 6;	/* no special reason, feels good */
	indent2 = level + exppp_continuation_indent;
	DICTdo_init(dict,&de);
	while (0 != (list = (Linked_List)DICTdo(&de))) {
		int first_time = True;
		LISTdo(list,r,struct Rename *)
			if (first_time) {
				raw("%s FROM %s\n",type,r->schema->symbol.name);
			} else {
				/* finish previous line */
				raw(",\n");
			}

			if (first_time) {
				raw("%*s(",level,"");
				first_time = False;
			} else {
				raw("%*s ",level,"");
			}
			raw(r->old->name);
			if (r->old != r->nnew) {
				wrap(" AS %s",r->nnew->name);
			}
		LISTod
		raw(");\n");
	}
	HASHdestroy(dict);
}

void
ALGscope_out(Scope s, int level)
{
	SCOPEtypes_out(s,level);
	SCOPEentities_out(s,level);
	SCOPEalgs_out(s,level);

	SCOPEconsts_out(s,level);
	SCOPElocals_out(s,level);
}

void
SCOPEadd_inorder(Linked_List list,Scope s)
{
	Link k = 0;

	LISTdo_links(list,link)
		if (0 > strcmp(
				SCOPEget_name(s),
				SCOPEget_name((Type)(link->data)))) {
			k = link;
			break;
		}
	LISTod

	LISTadd_before(list,k,(Generic)s);
}

/* print the rules in a scope */
void
SCOPErules_out(Scope s,int level)
{
	Rule r;
	DictionaryEntry de;

	if (exppp_alphabetize == False) {
		DICTdo_type_init(s->symbol_table,&de,OBJ_RULE);
		while (0 != (r = (Rule)DICTdo(&de))) {
			RULE_out(r,level);
		}
	} else {
		Linked_List alpha = LISTcreate();

		DICTdo_type_init(s->symbol_table,&de,OBJ_RULE);
		while (0 != (r = (Rule)DICTdo(&de))) {
			SCOPEadd_inorder(alpha,r);
		}

		LISTdo(alpha,r,Rule)
			RULE_out(r,level);
		LISTod

		LISTfree(alpha);
	}

}

/* print the functions in a scope */
void
SCOPEfuncs_out(Scope s,int level)
{
	Function f;
	DictionaryEntry de;

	if (exppp_alphabetize == False) {
		DICTdo_type_init(s->symbol_table,&de,OBJ_FUNCTION);
		while (0 != (f = (Function)DICTdo(&de))) {
			FUNC_out(f,level);
		}
	} else {
		Linked_List alpha = LISTcreate();

		DICTdo_type_init(s->symbol_table,&de,OBJ_FUNCTION);
		while (0 != (f = (Function)DICTdo(&de))) {
			SCOPEadd_inorder(alpha,f);
		}

		LISTdo(alpha,f,Function)
			FUNC_out(f,level);
		LISTod

		LISTfree(alpha);
	}

}

/* print the procs in a scope */
void
SCOPEprocs_out(Scope s,int level)
{
	Procedure p;
	DictionaryEntry de;

	if (exppp_alphabetize == False) {
		DICTdo_type_init(s->symbol_table,&de,OBJ_PROCEDURE);
		while (0 != (p = (Procedure)DICTdo(&de))) {
			PROC_out(p,level);
		}
	} else {
		Linked_List alpha = LISTcreate();

		DICTdo_type_init(s->symbol_table,&de,OBJ_PROCEDURE);
		while (0 != (p = (Procedure)DICTdo(&de))) {
			SCOPEadd_inorder(alpha,p);
		}

		LISTdo(alpha,p,Procedure)
			PROC_out(p,level);
		LISTod

		LISTfree(alpha);
	}

}

/* print the algorithms in a scope */
void
SCOPEalgs_out(Scope s,int level)
{
	/* Supplementary Directivies 2.1.1 requires rules to be separated */
	/* might as well separate funcs and procs, too */
	SCOPErules_out(s,level);
	SCOPEfuncs_out(s,level);
	SCOPEprocs_out(s,level);
}

static
min(int a, int b, int c)
{
    if (a < b)
	return ((a < c) ? a : c);
    else
	return ((b < c) ? b : c);
}

static
copy_file_chunk(char *filename, int start, int end, int level)
{
    FILE *infile;
    char buff[256];
    int i, indent, undent = 0, fix;

    if (!(infile = fopen(filename, "r"))) {
	ERRORreport(ERROR_file_unreadable, filename, strerror(errno));
    }

    /* skip to start of chunk */
    for (i = start; --i; )
	fgets(buff, 255, infile);

    /* copy first line and compute indentation correction factor */
    fgets(buff, 255, infile);
    indent = level - strspn(buff, " ");
    if (indent < 0) {
	undent = -indent;
	indent = 0;
    }
    raw("%*s%s", indent, "", buff + undent);
    indent = indent - undent;

    /* copy the rest */
    for (i = end - start; i--; ) {
	fgets(buff, 255, infile);
	fix = min(undent, strlen(buff), strspn(buff, " "));
	raw("%*s%s", indent + fix, "", buff + fix);
    }

    fclose(infile);
}

void
RULE_out(Rule r,int level)
{
	int i = 0;

	first_newline();
	exppp_ref_info(&r->symbol);

	if (exppp_preserve_comments == False) {
	    raw("%*sRULE %s FOR (",level,"",r->symbol.name);

	    LISTdo(r->u.rule->parameters,p,Variable)
		i++;
		if (i != 1) raw(", ");
		wrap(p->name->symbol.name);
	    LISTod;
	    raw(");\n");

	    ALGscope_out(r,level+exppp_nesting_indent);
	    STMTlist_out(r->u.rule->body,level+exppp_nesting_indent);
	    raw("\n");
	    WHERE_out(RULEget_where(r),level);

	    raw("\n%*sEND_RULE; -- %s\n",level,"",r->symbol.name);
	} else {
	    copy_file_chunk(r->symbol.filename, r->u.rule->text.start,
			    r->u.rule->text.end, level);
	}
}

/* last arg is not terminated with ; or \n */
void
ALGargs_out(Linked_List args,int level)
{
	Type previoustype = 0;
	indent2 = level + exppp_continuation_indent;

	/* combine adjacent parameters that have the same type */

	LISTdo(args,v,Variable)
		if (previoustype != v->type) {
			if (previoustype) {
				wrap(":");
				TYPE_head_out(previoustype,NOLEVEL);
				raw(";\n");
			}
			raw("%*s",level,"");
			EXPR_out(VARget_name(v),0);
		} else {
			raw(", ");
			EXPR_out(VARget_name(v),0);
		}
		previoustype = v->type;
	LISTod

	wrap(":");
	TYPE_head_out(previoustype,NOLEVEL);
}

void
FUNC_out(Function fn,int level)
{
	if (fn->u.func->builtin) return;

	first_newline();
	exppp_ref_info(&fn->symbol);

	if (exppp_preserve_comments == False) {
	    raw("%*sFUNCTION %s",level,"",fn->symbol.name);

	    if (fn->u.func->parameters) {
		raw("(\n");
		ALGargs_out(fn->u.func->parameters,
			    level+strlen("FUNCTION     "));
		raw("\n%*s)",level+exppp_continuation_indent,"");
	    }
	    raw(":");

	    indent2 = curpos + exppp_continuation_indent;
	    TYPE_head_out(fn->u.func->return_type,NOLEVEL);
	    raw(";\n");

	    ALGscope_out(fn,level+exppp_nesting_indent);
	    STMTlist_out(fn->u.proc->body,level+exppp_nesting_indent);

	    raw("\n%*sEND_FUNCTION; -- %s\n",level,"",fn->symbol.name);
	} else {
	    copy_file_chunk(fn->symbol.filename, fn->u.func->text.start,
			    fn->u.func->text.end, level);
	}
}
void
PROC_out(Procedure p,int level)
{
	if (p->u.proc->builtin) return;

	first_newline();
	exppp_ref_info(&p->symbol);

	if (exppp_preserve_comments == False) {
	    raw("%*sPROCEDURE %s(\n",level,"",p->symbol.name);

	    ALGargs_out(p->u.proc->parameters,level+strlen("PROCEDURE     "));

	    raw("%*s);\n",level+exppp_nesting_indent,"");

	    ALGscope_out(p,level+exppp_nesting_indent);
	    STMTlist_out(p->u.proc->body,level+exppp_nesting_indent);

	    raw("\n%*sEND_PROCEDURE; -- %s\n",level,"",p->symbol.name);
	} else {
	    copy_file_chunk(p->symbol.filename, p->u.proc->text.start,
			    p->u.proc->text.end, level);
	}
}

void
SCOPEconsts_out(Scope s,int level)
{
	Variable v;
	DictionaryEntry de;
	int max_indent = 0;
	Dictionary d = s->symbol_table;

	DICTdo_type_init(d,&de,OBJ_VARIABLE);
	while (0 != (v = (Variable)DICTdo(&de))) {
		if (!v->flags.constant) continue;
		if (strlen(v->name->symbol.name) > max_indent)
			max_indent = strlen(v->name->symbol.name);
	}

	if (!max_indent) return;

	first_newline();

	raw("%*sCONSTANT\n",level,"");

	indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;

	DICTdo_type_init(d,&de,OBJ_VARIABLE);
	while (0 != (v = (Variable)DICTdo(&de))) {
		if (!v->flags.constant) continue;

		/* print attribute name */
		raw("%*s%-*s :",level,"",
			max_indent,v->name->symbol.name);

		/* print attribute type */
		if (VARget_optional(v)) wrap(" OPTIONAL");
		TYPE_head_out(v->type,NOLEVEL);

		if (v->initializer) {
			wrap(" := ");
			EXPR_out(v->initializer,0);
		}

		raw(";\n");
	}
		
	raw("%*sEND_CONSTANT;\n",level,"");
}

void
SCOPElocals_out(Scope s,int level)
{
	Variable v;
	DictionaryEntry de;
	int max_indent = 0;
	Dictionary d = s->symbol_table;

	DICTdo_type_init(d,&de,OBJ_VARIABLE);
	while (0 != (v = (Variable)DICTdo(&de))) {
		if (v->flags.constant) continue;
		if (v->flags.parameter) continue;
		if (strlen(v->name->symbol.name) > max_indent)
			max_indent = strlen(v->name->symbol.name);
	}

	if (!max_indent) return;

	first_newline();

	raw("%*sLOCAL\n",level,"");
	indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;

	DICTdo_type_init(d,&de,OBJ_VARIABLE);
	while (0 != (v = (Variable)DICTdo(&de))) {
		if (v->flags.constant) continue;
		if (v->flags.parameter) continue;

		/* print attribute name */
		raw("%*s%-*s :",level+exppp_nesting_indent,"",
			max_indent,v->name->symbol.name);

		/* print attribute type */
		if (VARget_optional(v)) wrap(" OPTIONAL");
		TYPE_head_out(v->type,NOLEVEL);

		if (v->initializer) {
			wrap(" := ");
			EXPR_out(v->initializer,0);
		}

		raw(";\n");
	}
		
	raw("%*sEND_LOCAL;\n",level,"");
}

LOOPout(struct Loop_ *loop,int level)
{
	Variable v;

	raw("%*sREPEAT",level,"");

	/* increment */
/*	if (loop->scope->u.incr) {*/
	if (loop->scope) {
		DictionaryEntry de;

		DICTdo_init(loop->scope->symbol_table,&de);
		v = (Variable)DICTdo(&de);
		wrap(" %s := ",v->name->symbol.name);
		EXPR_out(loop->scope->u.incr->init,0);
		wrap(" TO ");
		EXPR_out(loop->scope->u.incr->end,0);
		wrap(" BY ");	/* parser always forces a "by" expr */
		EXPR_out(loop->scope->u.incr->increment,0);
	}

	/* while */
	if (loop->while_expr) {
		wrap(" WHILE ");
		EXPR_out(loop->while_expr,0);
	}

	/* until */
	if (loop->until_expr) {
		wrap(" UNTIL ");
		EXPR_out(loop->until_expr,0);
	}

	raw(";\n");

	STMTlist_out(loop->statements,level+exppp_nesting_indent);

	raw("%*sEND_REPEAT;\n",level,"");
}

void
CASEout(struct Case_Statement_ *c,int level)
{
	int len;
	char *string;
	int max_indent;

	raw("%*sCASE ",level,"");
	EXPR_out(c->selector,0);
	wrap(" OF\n");

	/* pass 1: calculate length of longest label */
	max_indent = 0;
	LISTdo(c->cases,ci,Case_Item)
		if (ci->labels) {
			LISTdo(ci->labels,label,Expression)
				len = EXPRlength(label);
			LISTod
		} else {
			len = strlen("OTHERWISE");
		}
		if (len > max_indent)
			max_indent = len;
	LISTod

	level += exppp_nesting_indent;

	/* pass 2: print them */
	LISTdo(c->cases,ci,Case_Item)
		if (ci->labels) {
		    LISTdo(ci->labels,label,Expression)
			/* print label(s) */
			indent2 = level + exppp_continuation_indent;
			raw("%*s",level,"");
			EXPR_out(label,0);
			raw("%*s : ",level+max_indent - curpos,"");

			/* print action */
			STMT_out(ci->action,level+exppp_nesting_indent);
		    LISTod
	        } else {
			/* print OTHERWISE */
			indent2 = level + exppp_continuation_indent;
			raw("%*s",level,"");
			raw("OTHERWISE");
			raw("%*s : ",level+max_indent - curpos,"");

			/* print action */
			STMT_out(ci->action,level+exppp_nesting_indent);
		}
	LISTod

	raw("%*sEND_CASE;\n",level,"");
}

void
STMT_out(Statement s,int level)
{
	int first_time = True;

	if (!s) {	/* null statement */
		raw("%*s;\n",level,"");
		return;
	}

	indent2 = level + exppp_continuation_indent;

	switch (s->type) {
	case STMT_ASSIGN:
		raw("%*s",level,"");
		EXPR_out(s->u.assign->lhs,0);
		wrap(" := ");
		EXPR_out(s->u.assign->rhs,0);
		raw(";\n",level,"");
		break;
	case STMT_CASE:
		CASEout(s->u.Case,level);
		break;
	case STMT_COMPOUND:
		raw("%*sBEGIN\n",level,"");
		STMTlist_out(s->u.compound->statements,level+exppp_nesting_indent);
		raw("%*sEND;\n",level,"");
		break;
	case STMT_COND:
		raw("%*sIF ",level,"");
		EXPR_out(s->u.cond->test,0);
		wrap(" THEN\n");
		STMTlist_out(s->u.cond->code,level+exppp_nesting_indent);
		if (s->u.cond->otherwise) {
			raw("%*sELSE\n",level,"");
			STMTlist_out(s->u.cond->otherwise,level+exppp_nesting_indent);
		}
		raw("%*sEND_IF;\n",level,"");
		break;
	case STMT_LOOP:
		LOOPout(s->u.loop,level);
		break;
	case STMT_PCALL:
		raw("%*s%s(",level,"",s->symbol.name);
		LISTdo(s->u.proc->parameters,p,Expression)
			if (first_time) first_time = False;
			else raw(",");
			EXPR_out(p,0);
		LISTod
		raw(");\n");
		break;
	case STMT_RETURN:
		raw("%*sRETURN",level,"");
		if (s->u.ret->value) {
			wrap("(");
			EXPR_out(s->u.ret->value,0);
			raw(")");
		}
		raw(";\n");
		break;
	case STMT_ALIAS:
		raw("%*sALIAS %s for %s;\n",level,"",s->symbol.name,
/* should be generalized reference */
			s->u.alias->variable->name->symbol.name);
		STMTlist_out(s->u.alias->statements,level+exppp_nesting_indent);
		raw("%*sEND_ALIAS; -- %s\n",level,"",s->symbol.name);
		break;
	case STMT_SKIP:
		raw("%*sSKIP;\n",level,"");
		break;
	case STMT_ESCAPE:
		raw("%*sESCAPE;\n",level,"");
		break;
	}
}

STMTlist_out(Linked_List stmts,int level)
{
	LISTdo(stmts,stmt,Statement)
		STMT_out(stmt,level);
	LISTod
}

/* print all entities in a scope */
void
SCOPEentities_out(Scope s,int level)
{
	Entity e;
	DictionaryEntry de;

	if (exppp_alphabetize == False) {
		DICTdo_type_init(s->symbol_table,&de,OBJ_ENTITY);
		while (0 != (e = (Entity)DICTdo(&de))) {
			ENTITY_out(e,level);
		}
	} else {
		Linked_List alpha = LISTcreate();

		DICTdo_type_init(s->symbol_table,&de,OBJ_ENTITY);
		while (0 != (e = (Entity)DICTdo(&de))) {
			SCOPEadd_inorder(alpha,e);
		}

		LISTdo(alpha,e,Entity)
			ENTITY_out(e,level);
		LISTod

		LISTfree(alpha);
	}
}

void
SUBTYPEout(Expression e)
{
	/* language insists on having parens around entity names */
	/* even if there is only one, but if the expression is */
	/* complex, EXPRout will add on its own parens */
/*	if (TYPEis_expression(e->type)) {*/
		raw("(");
/*	}*/

	EXPR_out(e,0);

/*	if (TYPEis_expression(e->type)) {*/
		raw(")");
/*	}*/
}

#define EXPLICIT 0
#define DERIVED 1

void
ENTITY_out(Entity e,int level)
{
	int first_time = True;

	first_newline();
	exppp_ref_info(&e->symbol);

	raw("%*sENTITY %s",level,"",e->symbol.name);

	level += exppp_nesting_indent;
	indent2 = level + exppp_continuation_indent;

	if (ENTITYget_abstract(e)) {
		if (e->u.entity->subtype_expression) {
			raw("\n%*sABSTRACT SUPERTYPE OF ",level,"");
			SUBTYPEout(e->u.entity->subtype_expression);
		} else {
			raw("\n%*sABSTRACT SUPERTYPE",level,"");
		}
	} else {
		if (e->u.entity->subtype_expression) {
			raw("\n%*sSUPERTYPE OF ",level,"");
			SUBTYPEout(e->u.entity->subtype_expression);
		}
	}

	if (e->u.entity->supertype_symbols) {
		raw("\n%*sSUBTYPE OF (",level,"");

		LISTdo(e->u.entity->supertype_symbols,s,Symbol *)
			if (first_time) {
				first_time = False;
			} else {
				raw(", ");
			}
			wrap(s->name);
		LISTod
		raw(")");
	}

	raw(";\n");

#if 0
	/* add a little more space before entities if sub or super appears */
	if (e->u.entity->supertype_symbols || e->u.entity->subtype_expression) {
		raw("\n");
	}
#endif

	ENTITYattrs_out(e->u.entity->attributes,EXPLICIT,level);
	ENTITYattrs_out(e->u.entity->attributes,DERIVED,level);
	ENTITYinverse_out(e->u.entity->attributes,level);
	ENTITYunique_out(e->u.entity->unique,level);
	WHERE_out(TYPEget_where(e),level);

	level -= exppp_nesting_indent;
	raw("%*sEND_ENTITY; -- %s\n",level,"",e->symbol.name);
}

void
ENTITYunique_out(Linked_List u,int level)
{
	int i;
	int max_indent;
	Symbol *sym;
	int length;

	if (!u) return;

	raw("%*sUNIQUE\n",level,"");

	/* pass 1 */
	max_indent = 0;
	LISTdo(u,list,Linked_List)
		if (0 != (sym = (Symbol *)LISTget_first(list))) {
			length = strlen(sym->name);
			if (length > max_indent) max_indent = length;
		}
	LISTod

	level += exppp_nesting_indent;
	indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;

	LISTdo(u,list,Linked_List)
		i = 0;
		LISTdo(list,v,Variable)
			i++;
			if (i == 1) {
				/* print label if present */
				if (v) {
					raw("%*s%-*s : ",level,"",
						max_indent,((Symbol *)v)->name);
				} else {
					raw("%*s%-*s   ",level,"",
						max_indent,"");
				}
			} else {
				if (i > 2) raw(", ");
				EXPR_out(v->name,0);
			}
		LISTod
		raw(";\n");
	LISTod
}

void
ENTITYinverse_out(Linked_List attrs,int level)
{
	int length;

	int max_indent;

	/* pass 1: calculate length of longest attr name */
	max_indent = 0;
	LISTdo(attrs,v,Variable)
		if (v->inverse_symbol) {
			length = strlen(v->name->symbol.name);
			if (length > max_indent) max_indent = length;
		}
	LISTod

	if (max_indent == 0) return;
	raw("%*sINVERSE\n",level,"");
	level += exppp_nesting_indent;
	indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;

	/* pass 2: print them */
	LISTdo(attrs,v,Variable)
		if (v->inverse_symbol) {
			/* print attribute name */
			raw("%*s%-*s :",level,"",
				max_indent,v->name->symbol.name);

			/* print attribute type */
			if (VARget_optional(v)) wrap(" OPTIONAL");
			TYPE_head_out(v->type,NOLEVEL);

			raw(" FOR ");

			wrap(v->inverse_attribute->name->symbol.name);

			raw(";\n");
		}
	LISTod
}

void
ENTITYattrs_out(Linked_List attrs,int derived,int level)
{
	int length;

	int max_indent;

	/* pass 1: calculate length of longest attr name */
	max_indent = 0;
	LISTdo(attrs,v,Variable)
		if (v->inverse_symbol) continue;
		if ((derived && v->initializer) ||
		   (!derived && !v->initializer)) {
			length = EXPRlength(v->name);
			if (length > max_indent) max_indent = length;
		}
	LISTod

	if (max_indent == 0) return;
	if (derived) raw("%*sDERIVE\n",level,"");
	level += exppp_nesting_indent;
	indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;

	/* pass 2: print them */
	LISTdo(attrs,v,Variable)
		if (v->inverse_symbol) continue;
		if ((derived && v->initializer) ||
		   (!derived && !v->initializer)) {
			/* print attribute name */
			raw("%*s",level,"");
			EXPR_out(v->name,0);
			raw("%*s :",level+max_indent+1 - curpos,"");

			/* print attribute type */
			if (VARget_optional(v)) wrap(" OPTIONAL");
			TYPE_head_out(v->type,NOLEVEL);

			if (derived && v->initializer) {
				wrap(" := ");
				EXPR_out(v->initializer,0);
			}

			raw(";\n");
		}
	LISTod
}

void
WHERE_out(Linked_List wheres,int level)
{
	int max_indent;
	if (!wheres) return;

	raw("%*s%s",level,"","WHERE\n");
	level += exppp_nesting_indent;

	/* pass 1: calculate length of longest label */
	max_indent = 0;
	LISTdo(wheres,w,Where)
		if (w->label) {
			if (strlen(w->label->name) > max_indent)
				max_indent = strlen(w->label->name);
		}
	LISTod

	if (max_indent > 10) {
		/* don't bother indenting completely for labels that are */
		/* ridiculously long */
		max_indent = 4;
	}
	indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;

	/* pass 2: now print labels and exprs */
	LISTdo(wheres,w,Where)
		if (w->label) {
			raw("%*s%-*s: ",level,"",max_indent,w->label->name);
		} else {
			/* no label */
			raw("%*s%-*s  ",level,"",max_indent,"");
		}
		EXPR_out(w->expr,max_indent);
		raw(";\n");
	LISTod
}

/* print all types in a scope */
void
SCOPEtypes_out(Scope s, int level)
{
	DictionaryEntry de;
	Type t;

	if (exppp_alphabetize == False) {
		DICTdo_type_init(s->symbol_table,&de,OBJ_TYPE);
		while (0 != (t = (Type)DICTdo(&de))) {
			TYPE_out(t,level);
		}
	} else {
		Linked_List alpha = LISTcreate();

		DICTdo_type_init(s->symbol_table,&de,OBJ_TYPE);
		while (0 != (t = (Type)DICTdo(&de))) {
			SCOPEadd_inorder(alpha,t);
		}

		LISTdo(alpha,t,Type)
			TYPE_out(t,level);
		LISTod

		LISTfree(alpha);
	}
}

/* print a type definition.  I.e., a TYPE statement */
void
TYPE_out(Type t, int level)
{
	first_newline();
	exppp_ref_info(&t->symbol);

	raw("%*sTYPE %s =",level,"",t->symbol.name);
	if (TYPEget_head(t)) {
		wrap(" %s",TYPEget_name(TYPEget_head(t)));
	} else {
		TYPE_body_out(t,level+exppp_nesting_indent);
	}		

	raw(";\n");

	WHERE_out(t->where,level);

	raw("%*sEND_TYPE; -- %s\n",level,"",t->symbol.name);
}

/* prints type description (preceded by a space).  I.e., the type of an */
/* attribute or other object */
void
TYPE_head_out(Type t,int level)
{
	if (t->symbol.name) {
		wrap(" %s",t->symbol.name);
	} else {
		TYPE_body_out(t,level);
	}
}

TYPEunique_or_optional_out(TypeBody tb)
{
	if (tb->flags.unique)	wrap(" UNIQUE");
	if (tb->flags.optional)	wrap(" OPTIONAL");
}

void
TYPE_body_out(Type t, int level)
{
	int first_time = True;

	Expression expr;
	DictionaryEntry de;

	TypeBody tb = TYPEget_body(t);

	switch (tb->type) {
	case integer_:		wrap(" INTEGER");	break;
	case real_:		wrap(" REAL");	break;
	case string_:		wrap(" STRING");	break;
	case binary_:		wrap(" BINARY");	break;
	case boolean_:		wrap(" BOOLEAN");	break;
	case logical_:		wrap(" LOGICAL");	break;
	case number_:		wrap(" NUMBER");	break;
	case entity_:		wrap(" %s",tb->entity->symbol.name);
				break;
	case aggregate_:
	case array_:
	case bag_:
	case set_:
	case list_:
		switch (tb->type) {
		/* ignore the aggregate bounds for now */
		case aggregate_:	wrap(" AGGREGATE");
					if (tb->tag) {
						wrap(":%s",tb->tag->symbol.name);
					}
					wrap(" OF");
					break;

		case array_:		wrap(" ARRAY");
					EXPRbounds_out(tb);
					wrap(" OF");
					TYPEunique_or_optional_out(tb);
					break;

		case bag_:		wrap(" BAG");
					EXPRbounds_out(tb);
					wrap(" OF");
					break;

		case set_:		wrap(" SET");
					EXPRbounds_out(tb);
					wrap(" OF");
					break;

		case list_:		wrap(" LIST");
					EXPRbounds_out(tb);
					wrap(" OF");
					TYPEunique_or_optional_out(tb);
					break;
		}

		TYPE_head_out(tb->base,level);
		break;
	case enumeration_:
	{
#if 1
		int i, count = 0;
		char **names;

		/*
		 * write names out in original order by first bucket sorting
		 * to a temporary array.  This is trivial since all buckets
		 * will get filled with one and only one object.
		 */
		DICTdo_type_init(t->symbol_table,&de,OBJ_EXPRESSION);
		while (0 != (expr = (Expression)DICTdo(&de))) {
			count++;
		}
		names = (char **)malloc(count * sizeof(char *));
		DICTdo_type_init(t->symbol_table,&de,OBJ_EXPRESSION);
		while (0 != (expr = (Expression)DICTdo(&de))) {
			names[expr->u.integer-1] = expr->symbol.name;
		}

		wrap(" ENUMERATION OF\n");
		
		for (i=0;i<count;i++) {
			/* finish line from previous enum item */
			if (!first_time) raw(",\n");

			/* start new enum item */
			if (first_time) {
				raw("%*s(",level,"");
				first_time = False;
			} else {
				raw("%*s ",level,"");
			}
			raw(names[i]);
		}
		raw(")");
		free((char *)names);
	}
#else
		wrap(" ENUMERATION OF\n");
		DICTdo_type_init(t->symbol_table,&de,OBJ_EXPRESSION);
		while (0 != (expr = (Expression)DICTdo(&de))) {

			/* finish line from previous enum item */
			if (!first_time) raw(",\n");

			/* start new enum item */
			if (first_time) {
				raw("%*s(",level,"");
				first_time = False;
			} else {
				raw("%*s ",level,"");
			}
			raw(expr->symbol.name);
		}
		raw(")");
#endif
		break;
	case select_:
		wrap(" SELECT\n");
		LISTdo(tb->list,type,Type)
			/* finish line from previous entity */
			if (!first_time) raw(",\n");

			/* start new entity */
			if (first_time) {
				raw("%*s(",level,"");
				first_time = False;
			} else {
				raw("%*s ",level,"");
			}
			raw(type->symbol.name);
		LISTod

		/* if empty, force a left paren */
		if (first_time) {
			ERRORreport_with_symbol(ERROR_select_empty,&error_sym,t->symbol.name);
			raw("%*s(",level,"");
		}
		raw(")");
		break;
	case generic_:
		wrap(" GENERIC");
		if (tb->tag) {
			wrap(":%s",tb->tag->symbol.name);
		}
		break;
	default:	wrap(" (* unknown type %d *)",tb->type);
	}

	if (tb->precision) {
		wrap(" (");
		EXPR_out(tb->precision,0);
		raw(")");
	}
	if (tb->flags.fixed)	wrap(" FIXED");
}

void
EXPRbounds_out(TypeBody tb)
{
	if (!tb->upper) return;

	wrap(" [");
	EXPR_out(tb->lower,0);
	wrap(":");
	EXPR_out(tb->upper,0);
	raw("]");
}

/*
 if paren == 1, parens are usually added to prevent possible rebind by
	higher-level context.  If op is similar to previous op (and
	precedence/associativity is not a problem) parens may be omitted.
 if paren == 0, then parens may be omitted without consequence
*/
void
EXPR__out(Expression e,int paren,int previous_op)
{
	int i;	/* trusty temporary */

	switch (TYPEis(e->type)) {
	case integer_:
		if (e == LITERAL_INFINITY) {
			wrap("?");
		} else {	
			wrap("%d",e->u.integer);
		}
		break;
	case real_:
		if (e == LITERAL_PI) {
			wrap("PI");
		} else if (e == LITERAL_E) {
			wrap("E");
		} else {
			wrap("%g",e->u.real);
		}
		break;
	case binary_:
		wrap("%%%s",e->u.binary);	/* put "%" back */
		break;
	case logical_:
	case boolean_:
		switch (e->u.logical) {
		case Ltrue:  wrap("TRUE");	   break;
		case Lfalse: wrap("FALSE");   break;
		default:     wrap("UNKNOWN"); break;
		}
		break;
	case string_:
		if (TYPEis_encoded(e->type)) {
			wrap("\"%s\"",e->symbol.name);
		} else {
			wrap("'%s'",e->symbol.name);
		}
		break;
	case entity_:
	case identifier_:
	case attribute_:
	case enumeration_:
		wrap("%s",e->symbol.name);
		break;
	case query_:
		wrap("QUERY ( %s <* ",e->u.query->local->name->symbol.name);
		EXPR_out(e->u.query->aggregate,1);
		wrap(" | ");
		EXPR_out(e->u.query->expression,1);
		raw(" )");
		break;
	case self_:
		wrap("SELF");
		break;
	case funcall_:
		wrap("%s(",e->symbol.name);
		i = 0;
		LISTdo(e->u.funcall.list,arg,Expression)
			i++;
			if (i != 1) raw(",");
			EXPR_out(arg,0);
		LISTod
		raw(")");
		break;
	case op_:
		EXPRop__out(&e->e,paren,previous_op);
		break;
	case aggregate_:
		wrap("[");
		i = 0;
		LISTdo(e->u.list,arg,Expression)
			i++;
			if (i!= 1) raw(",");
			EXPR_out(arg,0);
		LISTod
		raw("]");
		break;
	case oneof_:
		wrap("ONEOF (");

		i = 0;
		LISTdo(e->u.list,arg,Expression)
			i++;
			if (i != 1) raw(",");
			EXPR_out(arg,0);
		LISTod

		raw(")");
		break;
	default:
		wrap("unknown expression, type %d",TYPEis(e->type));
	}
}

#define PAD	1
#define NOPAD	0

/* print expression that has op and operands */
void
EXPRop__out(struct Op_Subexpression *oe,int paren,int previous_op)
{
	switch (oe->op_code) {
	case OP_AND:
	case OP_ANDOR:
	case OP_OR:
	case OP_CONCAT:
	case OP_EQUAL:
	case OP_PLUS:
	case OP_TIMES:
	case OP_XOR:
			EXPRop2__out(oe,(char *)0,paren,PAD,previous_op);break;
	case OP_EXP:
	case OP_GREATER_EQUAL:
	case OP_GREATER_THAN:
	case OP_IN:
	case OP_INST_EQUAL:
	case OP_INST_NOT_EQUAL:
	case OP_LESS_EQUAL:
	case OP_LESS_THAN:
	case OP_LIKE:
	case OP_MOD:
	case OP_NOT_EQUAL:
			EXPRop2_out(oe,(char *)0,paren,PAD);	break;
	case OP_NOT:	EXPRop1_out(oe,"NOT ",paren);		break;
	case OP_REAL_DIV:
	case OP_DIV:	EXPRop2_out(oe,"/",paren,PAD);		break;
	case OP_MINUS:	EXPRop2_out(oe,"-",paren,PAD);		break;
	case OP_DOT:	EXPRop2_out(oe,".",paren,NOPAD);	break;
	case OP_GROUP:	EXPRop2_out(oe,"\\",paren,NOPAD);	break;
	case OP_NEGATE:	EXPRop1_out(oe,"-",paren);		break;
	case OP_ARRAY_ELEMENT:
			EXPR_out(oe->op1,1);
			wrap("[");
			EXPR_out(oe->op2,0);
			raw("]");				break;
	case OP_SUBCOMPONENT:
			EXPR_out(oe->op1,1);
			wrap("[");
			EXPR_out(oe->op2,0);
			wrap(":");
			EXPR_out(oe->op3,0);
			raw("]");				break;
	default:
	wrap("(* unknown op-expression *)");
	}
}

void
EXPRop2__out(struct Op_Subexpression *eo,char *opcode,int paren,int pad,int previous_op)
{
	if (pad && paren && (eo->op_code != previous_op)) wrap("(");
	EXPR__out(eo->op1,1,eo->op_code);
	if (pad) raw(" ");
	wrap("%s",(opcode?opcode:EXPop_table[eo->op_code].token));
	if (pad) wrap(" ");
	EXPR__out(eo->op2,1,eo->op_code);
	if (pad && paren && (eo->op_code != previous_op)) raw(")");
}

/* Print out a one-operand operation.  If there were more than two of these */
/* I'd generalize it to do padding, but it's not worth it. */
void
EXPRop1_out(struct Op_Subexpression *eo,char *opcode,int paren)
{
	if (paren) wrap("(");
	wrap("%s",opcode);
	EXPR_out(eo->op1,1);
	if (paren) raw(")");
}

int
EXPRop_length(struct Op_Subexpression *oe)
{
	switch (oe->op_code) {
	case OP_DOT:
	case OP_GROUP:
		return(1+EXPRlength(oe->op1)
			+EXPRlength(oe->op2));
	default:
		fprintf(stdout,"EXPRop_length: unknown op-expression");
	}
	return 0;
}

/* returns printable representation of expression rather than printing it */
/* originally only used for general references, now being expanded to handle */
/* any kind of expression */
/* contains fragment of string, adds to it */
void
EXPRstring(char *buffer,Expression e)
{
	int i;

	switch (TYPEis(e->type)) {
	case integer_:
		if (e == LITERAL_INFINITY) strcpy(buffer,"?");
		else sprintf(buffer,"%d",e->u.integer);
		break;
	case real_:
		if (e == LITERAL_PI) {
			strcpy(buffer,"PI");
		} else if (e == LITERAL_E) {
			strcpy(buffer,"E");
		} else {
			sprintf(buffer,"%g",e->u.real);
		}
		break;
	case binary_:
		sprintf(buffer,"%%%s",e->u.binary);	/* put "%" back */
		break;
	case logical_:
	case boolean_:
		switch (e->u.logical) {
		case Ltrue:  strcpy(buffer,"TRUE");	   break;
		case Lfalse: strcpy(buffer,"FALSE");   break;
		default:     strcpy(buffer,"UNKNOWN"); break;
		}
		break;
	case string_:
		if (TYPEis_encoded(e->type)) {
			sprintf(buffer,"\"%s\"",e->symbol.name);
		} else {
			sprintf(buffer,"'%s'",e->symbol.name);
		}
		break;
	case entity_:
	case identifier_:
	case attribute_:
	case enumeration_:
		strcpy(buffer,e->symbol.name);
		break;
	case query_:
		sprintf(buffer,"QUERY ( %s <* ",e->u.query->local->name->symbol.name);
		EXPRstring(buffer+strlen(buffer),e->u.query->aggregate);
		strcat(buffer," | ");
		EXPRstring(buffer+strlen(buffer),e->u.query->expression);
		strcat(buffer," )");
		break;
	case self_:
		strcpy(buffer,"SELF");
		break;
	funcall_:
		sprintf(buffer,"%s(",e->symbol.name);
		i = 0;
		LISTdo(e->u.funcall.list,arg,Expression)
			i++;
			if (i != 1) strcat(buffer,",");
			EXPRstring(buffer+strlen(buffer),arg);
		LISTod
		strcat(buffer,")");
		break;

	case op_:
		EXPRop_string(buffer,&e->e);
		break;
	aggregate_:
		strcpy(buffer,"[");
		i = 0;
		LISTdo(e->u.list,arg,Expression)
			i++;
			if (i!= 1) strcat(buffer,",");
			EXPRstring(buffer+strlen(buffer),arg);
		LISTod
		strcat(buffer,"]");
		break;
	case oneof_:
		strcpy(buffer,"ONEOF (");

		i = 0;
		LISTdo(e->u.list,arg,Expression)
			i++;
			if (i != 1) strcat(buffer,",");
			EXPRstring(buffer+strlen(buffer),arg);
		LISTod

		strcat(buffer,")");
		break;
	default:
		sprintf(buffer,"EXPRstring: unknown expression, type %d",TYPEis(e->type),buffer);
		fprintf(stderr,buffer);
	}
}

void
EXPRop_string(char *buffer,struct Op_Subexpression *oe)
{
	EXPRstring(buffer,oe->op1);
	switch (oe->op_code) {
	case OP_DOT:
		strcat(buffer,".");
		break;
	case OP_GROUP:
		strcat(buffer,"\\");
		break;
	default:
		strcat(buffer,"(* unknown op-expression *)");
	}
	EXPRstring(buffer+strlen(buffer),oe->op2);
}

/* returns length of printable representation of expression w.o. printing it */
int
EXPRlength(Expression e)
{
	char buffer[10000];

	*buffer = '\0';
	EXPRstring(buffer,e);
	return(strlen(buffer));
}


/* Interfacing Definitions */

#define BIGBUFSIZ	100000
static old_curpos;
static old_lineno;
static int string_func_in_use = False;
static int file_func_in_use = False;

/* return 0 if successful */
static int
prep_buffer(char *buf,int len)
{
	/* this should never happen */
	if (string_func_in_use) {
		fprintf(stderr,"cannot generate EXPRESS string representations recursively!\n");
		return 1;
	}
	string_func_in_use = True;

	exppp_buf = exppp_bufp = buf;
	exppp_buflen = exppp_maxbuflen = len;

	*exppp_bufp = '\0';
	old_curpos = curpos;
	curpos = 1;
	old_lineno = 1;

	first_line = True;

	return 0;
}

/* return length of string */
static int
finish_buffer()
{
	exppp_buf = 0;
	curpos = old_curpos;
	error_sym.line = old_lineno;
	string_func_in_use = False;
	return 1+exppp_maxbuflen - exppp_buflen;
}

/* return 0 if successful */
static int
prep_string()
{
	/* this should never happen */
	if (string_func_in_use) {
		fprintf(stderr,"cannot generate EXPRESS string representations recursively!\n");
		return 1;
	}
	string_func_in_use = True;

	exppp_buf = exppp_bufp = (char*)malloc(BIGBUFSIZ);
	if (!exppp_buf) {
		fprintf(stderr,"failed to allocate exppp buffer\n");
		return 1;
	}
	exppp_buflen = exppp_maxbuflen = BIGBUFSIZ;

	*exppp_bufp = '\0';
	old_curpos = curpos;
	old_lineno = error_sym.line;
	curpos = 1;

	first_line = True;

	return 0;
}

static char *
finish_string()
{
	char *b = (char*)realloc(exppp_buf,1+exppp_maxbuflen-exppp_buflen);

	if (b == 0) {
		fprintf(stderr,"failed to reallocate exppp buffer\n");
		return 0;
	}
	exppp_buf = 0;
	curpos = old_curpos;
	error_sym.line = old_lineno;

	string_func_in_use = False;
	return b;
}

static FILE *oldfp;

static void
prep_file()
{
	/* this can only happen if user calls output func while suspended */
	/* inside another output func both called from debugger */
	if (file_func_in_use) {
		fprintf(stderr,"cannot print EXPRESS representations recursively!\n");
	}
	file_func_in_use = True;

	/* temporarily change file to stdout and print */
	/* This avoids messing up any printing in progress */
	oldfp = exppp_fp?exppp_fp:stdout;
	exppp_fp = stdout;
	curpos = 1;
}

static void
finish_file() {
	exppp_fp = oldfp;		/* reset back to original file */
	file_func_in_use = False;
}

static char *placeholder = "placeholder";

char *
SUBTYPEto_string(Expression e)
{
	if (prep_string()) return placeholder;
	EXPR_out(e,0);
	return (finish_string());
}

char *
ENTITYto_string(Entity e)
{
	if (prep_string()) return placeholder;
	ENTITY_out(e,0);
	return (finish_string());
}

/* return length of buffer used */
int
ENTITYto_buffer(Entity e,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	ENTITY_out(e,0);
	return(finish_buffer());
}

void
ENTITYout(Entity e)
{
	prep_file();
	ENTITY_out(e,0);
	finish_file();
}

char *
EXPRto_string(Expression e)
{
	if (prep_string()) return placeholder;
	EXPR_out(e,0);
	return (finish_string());
}

/* return length of buffer used */
int
EXPRto_buffer(Expression e,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	EXPR_out(e,0);
	return(finish_buffer());
}

void
EXPRout(Expression e)
{
	prep_file();
	EXPR_out(e,0);
	finish_file();
}

char *
FUNCto_string(Function f)
{
	if (prep_string()) return placeholder;
	FUNC_out(f,0);
	return (finish_string());
}

/* return length of buffer used */
int
FUNCto_buffer(Function e,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	FUNC_out(e,0);
	return(finish_buffer());
}

void
FUNCout(Function f)
{
	prep_file();
	FUNC_out(f,0);
	finish_file();
}

char *
PROCto_string(Procedure p)
{
	if (prep_string()) return placeholder;
	PROC_out(p,0);
	return (finish_string());
}

/* return length of buffer used */
int
PROCto_buffer(Procedure e,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	PROC_out(e,0);
	return(finish_buffer());
}

void
PROCout(Procedure p)
{
	prep_file();
	PROC_out(p,0);
	finish_file();
}

char *
RULEto_string(Rule r)
{
	if (prep_string()) return placeholder;
	RULE_out(r,0);
	return (finish_string());
}

/* return length of buffer used */
int
RULEto_buffer(Rule e,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	RULE_out(e,0);
	return(finish_buffer());
}

void
RULEout(Rule r)
{
	prep_file();
	RULE_out(r,0);
	finish_file();
}

char *
SCHEMAref_to_string(Schema s)
{
	if (prep_string()) return placeholder;
	REFout(s->u.schema->usedict,s->u.schema->use_schemas,"USE",0);
	REFout(s->u.schema->refdict,s->u.schema->ref_schemas,"REFERENCE",0);
	return (finish_string());
}

/* return length of buffer used */
int
SCHEMAref_to_buffer(Schema s,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	REFout(s->u.schema->usedict,s->u.schema->use_schemas,"USE",0);
	REFout(s->u.schema->refdict,s->u.schema->ref_schemas,"REFERENCE",0);
	return(finish_buffer());
}

void
SCHEMAref_out(Schema s)
{
	prep_file();
	REFout(s->u.schema->usedict,s->u.schema->use_schemas,"USE",0);
	REFout(s->u.schema->refdict,s->u.schema->ref_schemas,"REFERENCE",0);
	finish_file();
}

char *
STMTto_string(Statement s)
{
	if (prep_string()) return placeholder;
	STMT_out(s,0);
	return (finish_string());
}

/* return length of buffer used */
int
STMTto_buffer(Statement s,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	STMT_out(s,0);
	return(finish_buffer());
}

void
STMTout(Statement s)
{
	prep_file();
	STMT_out(s,0);
	finish_file();
}

char *
TYPEto_string(Type t)
{
	if (prep_string()) return placeholder;
	TYPE_out(t,0);
	return (finish_string());
}

/* return length of buffer used */
int
TYPEto_buffer(Type t,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	TYPE_out(t,0);
	return(finish_buffer());
}

void
TYPEout(Type t)
{
	prep_file();
	TYPE_out(t,0);
	finish_file();
}

char *
TYPEhead_to_string(Type t)
{
	if (prep_string()) return placeholder;
	TYPE_head_out(t,0);
	return (finish_string());
}

/* return length of buffer used */
int
TYPEhead_to_buffer(Type t,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	TYPE_out(t,0);
	return(finish_buffer());
}

void
TYPEhead_out(Type t)
{
	prep_file();
	TYPE_head_out(t,0);
	finish_file();
}

char *
TYPEbody_to_string(Type t)
{
	if (prep_string()) return placeholder;
	TYPE_body_out(t,0);
	return (finish_string());
}

/* return length of buffer used */
int
TYPEbody_to_buffer(Type t,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	TYPE_body_out(t,0);
	return(finish_buffer());
}

void
TYPEbody_out(Type t)
{
	prep_file();
	TYPE_body_out(t,0);
	finish_file();
}

char *
WHEREto_string(Linked_List w)
{
	if (prep_string()) return placeholder;
	WHERE_out(w,0);
	return (finish_string());
}

/* return length of buffer used */
int
WHEREto_buffer(Linked_List w,char *buffer,int length)
{
	if (prep_buffer(buffer,length)) return -1;
	WHERE_out(w,0);
	return(finish_buffer());
}

void
WHEREout(Linked_List w)
{
	prep_file();
	WHERE_out(w,0);
	finish_file();
}
